COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Martin:
C00010 ENDMK
C⊗;
Martin:
	Here is the pdp-10 and s-1 code for TAK. I commented the
assembly language one a bit. Originally it was in LAP so that I
could use the same timer for this as for all of my other Lisp
benchmarking, so there could be some transcription errors.
This is very much bummed as you can see. I use the address calculation
hardware to do all my arithmetic and comparisons. I don't check for
stack overflow or underflow, I've transformed the program by folding in
the first arm of the conditional, and I've chosen register conventions to
use DMOVE's everywhere. 

Here is the source level equivalent of these optimizations:

(defun btak (x y z)
 (prog ()
       (cond ((not (< y x))
	      (return z)))
	     
       tak2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak2))))))

(defun btak2 (x y z)
 (prog ()
       tak2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak2))))))

(defun timit ()
 ((lambda (t1 x gt)
	(btak 18. 12. 6.)
	  (setq t1 (- (runtime) t1))
	  (setq gt (- (status gctime) gt))
	  (print (list 'runtime
		       (QUOTIENT (FLOAT  (- t1 gt))
				 1000000.)))
	  (print (list 'gctime
		       (quotient (float gt) 1000000.))))
  (runtime) ()(status gctime)))

;;; P and FXP are stacks that are guaranteed large enough.
;;; a,b,c are general registers for arguments; c is the result
;;; register. P is the control stack, fxp the temporary stack.
;;; called via a pushj p,tak1

tak1	caig a,(b)		;x < y quit
	popj p,
tak2	add fxp,[5,,5]		;allocate 5 slots. 3 for args, 2 for temporaries
	dmovem a,-2(fxp)	;move a,b,c onto the stack. add is used to push
	movem c.(fxp)		;empty space, and the assumption of a large enough
				;stack is used here. PUSH, ADJSP both do bounds
				;checking. DMOVEM saves an instruction fetch and a
				;decode.
	movei a,-1(a)		;a←a-1 using the address hardware. Assumption
				;is that 18 bit, non-negative arithmetic is going on
	caile a,(b)		;early quit? c already contains the right result.
				;this early quit just unwinds the first arm of
				;the conditional. Tak2 is the entry after that arm
	pushj p,tak2		;no go on
	movem c,-4(fxp)		;save result on fxp
	dmove a,-1(fxp)		;get y,z
	move c,-2(fxp)		;and x
	movei a,-1(a)		;sub1
	caile a,(b)		;early quit
	pushj p,tak2
	movem c,-3(fxp)		;stash result
	move a,(fxp)		;z
	dmove b,-2(fxp)		;x,y
	movei a,-1(a)		;sub1
	caile a,(b)
	pushj p,tak2
	dmove a,-4(fxp)		;get first 2 results, the last already in c
				;notice how the choice of c as the results
				;register allowed us to hack the dmove's here
	sub fxp,[5,,5]		;flush temporary space
	caig a,(b)		;early quit on tail recursion?
	popj p,			;qed
	jrst tak2		;tail recursion

Here's the actual s-1 code I used. The same bums are right for this
machine too. This is the Mark I, not the Mark IIA.

title tak

DEFINE OUTSTR "(<{B}>)" STRING
	JSR #⊂STRING⊃,STROUT
TERMIN

pc←%3
a←%10
b←%11
c←%12

fxp←%34
sp←%36

go:	wspid #sp
	mov.d.d sp,[pdl ↔ pdlend]
	mov.d.d fxp,[fxpdl ↔ fxpdlend]
	timer time1
	movms.3 a,[18. ↔ 12. ↔ 6]
	jsr tak1
	timer time2
	outstr [asciz /Answer = /]
	mov a,c
	jsr decout
	outstr [asciz / in /]
	sub rta,time2+4,time1+4
	quo rta,#10.		;convert to microseconds
	mov a,rta
	jsr decout
	outstr [asciz / microseconds.
/]
	halt .

tak1:	skp.gtr a,b
	retsr pc,(sp)
tak2:	add fxp,#5*4
	movms.3 -3(fxp),a
	djmp.leq a
	jsr tak2
	mov -5(fxp),c
	mov.d.d a,-2(fxp)
	mov c,-3(fxp)
	djmp.leq a
	jsr tak2
	mov -4(fxp),c
	mov a,-1(fxp)
	mov.d.d b,-3(fxp)
	djmp.leq a
	jsr tak2
	mov.d.d a,-5(fxp)
	sub fxp,#5*4
	jmp.gtr a,tak2
	retsr pc,(sp)

decout:	div a,#10.
	jmpz.eql a,decou1
	jsr b,decout
decou1:	add b,?"0"
	outchr b
	retsr b,(sp)

STROUT:	ALLOC.2 A,#2*4
	MOV A,-4(SP)		;GET BYTE ADDRESS OF STRING
STROU1:	MOV.S.Q B,(A)		;GET NEXT BYTE
	JMPZ.EQL B,STROUD
	OUTCHR B
	IJMPA A,STROU1

STROUD:	MOVMS.2 A,-2(SP)
	RETSR PC,-2(SP)

time1:	block 2
time2:	block 2
pdl:	block 5000
pdlend:
fxpdl:	block 5000
fxpdlend:

	end go